home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tttool30.arc / MENU.TTT < prev    next >
Text File  |  1986-09-28  |  14KB  |  338 lines
  1. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {                                                                           }
  3. {           T E C H N O J O C K S     T U R B O    T O O L K I T            }
  4. {                                                                           }
  5. {                      Module   :   Menu.TTT                                }
  6. {                                                                           }
  7. {                      Version  :   3.0 , October 1, 1986                   }
  8. {                                                                           }
  9. {                      Purpose  :   Procedures for Menu creation            }
  10. {                                                                           }
  11. {                 Requirements  :   Decl.TTT                                }
  12. {                                   FastWrit.TTT                            }
  13. {                                   Window.ttt                              }
  14. {                                   Misc.ttt                                }
  15. {                                                                           }
  16. {  Proc  DisplayMenu(MenuDef:Menu_record;                                   }
  17. {                    Window:Boolean                                         }
  18. {                    var Choice,Errorcode : integer);                       }
  19. {                                                                           }
  20. {                                                                           }
  21. {                                                Bob Ainsbury               }
  22. {                                                Technojock                 }
  23. {                                                Houston                    }
  24. {                                                (713) 293-2760             }
  25. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  26.  
  27. Procedure DisplayMenu(MenuDef:Menu_record;Window:Boolean;
  28.                           var Choice,Errorcode : integer);
  29. Const
  30. Alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  31. Numbers  = '123456789';
  32. var
  33. I,J,X2,Y2 : integer;
  34. TextWidth : byte;
  35.  
  36.    Procedure GetDimensions;
  37.    var Fullwidth,Fulldepth: integer;
  38.  
  39.      Procedure CheckPrefix;         { 0   no prefix  }
  40.      begin                          { 1   numbers prefix}
  41.      with MenuDef do                { 2   letters prefix}
  42.      begin                          { 3   function key prefix}
  43.       If PicksPerLine < 1 then PicksPerLine := 1;
  44.       If (AddPrefix = 1) and (TotalPicks = 10) then
  45.         AddPrefix := 3;
  46.       If (AddPrefix in [1,3]) and (TotalPicks > 10) then
  47.         AddPrefix := 2;
  48.       If (Addprefix > 3) or (TotalPicks > 26) or (Addprefix < 0) then
  49.        Addprefix := 0;
  50.      end; {do}
  51.      end; {CheckPrefix}
  52.  
  53.      Procedure FindWidestLine;
  54.      var extra : integer;
  55.      begin
  56.      with MenuDef do
  57.       begin
  58.        Textwidth := 0;
  59.        For I := 1 to TotalPicks do
  60.         If length(Text[I]) > TextWidth then
  61.          Textwidth := length(Text[I]);         {find the longest text}
  62.        Case AddPrefix of
  63.        0   : Extra := 0;
  64.        1,2 : Extra := 2;
  65.        3   : If TotalPicks < 10 then
  66.                Extra := 3
  67.               else
  68.                Extra := 4;
  69.        end;  {case}
  70.        TextWidth := TextWidth + Extra;
  71.        If TextWidth > 80 then  {at least one of the lines is > 80 chars}
  72.         For J := I to TotalPicks do
  73.          If length(text[J]) - 80 - Extra> 0 then
  74.           Delete(Text[J],81,length(text[J]) - 80 - Extra);
  75.        If length(heading) - 80 > 0 then
  76.          Delete(Heading,81,length(heading) - 80);
  77.        If length(Heading) > Textwidth*PicksPerLine + PicksPerLine + 1 then
  78.         Textwidth := (length(Heading) - PicksPerLine - 1) div PicksPerLine;
  79.       end;
  80.      end;   {Proc FindWidestLine}
  81.  
  82.    Procedure Prefix;
  83.    begin
  84.    With MenuDef do
  85.    begin
  86.    Case AddPrefix of
  87.    1 : for I := 1 to TotalPicks do
  88.         Text[I] := int_to_str(I) + ' ' + Text[I];
  89.    2 : for I := 1 to TotalPicks do
  90.         Text[I] := Copy(Alphabet,I,1) + ' ' + Text[I];
  91.    3 : If TotalPicks < 10 then
  92.         for I := 1 to TotalPicks do
  93.          Text[I] := 'F'+Int_to_Str(I) + ' ' + Text[I]
  94.        else
  95.        begin                           {add extra space for F10 }
  96.         for I := 1 to 9 do
  97.          Text[I] := 'F'+Int_to_Str(I) + '  ' + Text[I];
  98.         Text[10] := 'F10 '+ Text[10];
  99.        end;
  100.    end; {case}
  101.    end;  {do}
  102.    end;
  103.  
  104.    Procedure LengthenText;
  105.    var J : integer;
  106.    begin
  107.    With MenuDef do
  108.    begin
  109.     For I := 1 to TotalPicks do
  110.      For J := length(Text[I]) + 1 to Textwidth do
  111.       Text[I] :=  Text[I] + ' ';
  112.    end; {do}
  113.    end;
  114.  
  115.    begin                              {Get_Dimensions}
  116.    CheckPrefix;
  117.    FindWidestLine;
  118.    With MenuDef do
  119.    begin
  120.     If (Addprefix > 0) then Prefix;
  121.     LengthenText;
  122.     {determine sensible values for left and right columns}
  123.     If TextWidth*PicksPerLine + PicksPerLine + 1 > 80 then  {check picks fit }
  124.     begin
  125.      Repeat
  126.       PicksPerLine := PicksPerLine - 1;
  127.      Until TextWidth*PicksPerLine + PicksPerLine + 1 <= 80;
  128.     end;
  129.  
  130.     If TextWidth*PicksPerLine + PicksPerLine + 1 > 78 then   {check box fits}
  131.      BoxType := 0;
  132.     Fullwidth := Textwidth*PicksPerLine + PicksPerLine + 1;
  133.     If BoxType > 0 then                               {add 2 to width if box }
  134.      Fullwidth := Fullwidth + 2;
  135.     If TopleftXY[1] = 0 then
  136.      TopleftXY[1] := (80 - Fullwidth) div 2;
  137.     If TopLeftXY[1] + Fullwidth <= 80 then
  138.      X2 := TopleftXY[1] + Fullwidth
  139.     else
  140.     begin
  141.      X2 := 80;
  142.      TopLeftXY[1] := 80 - Fullwidth + 1;
  143.     end;
  144.     {determine sensible values for top and bottom rows}
  145.     Fulldepth := TotalPicks div PicksPerLine;   {no of full rows of picks}
  146.     If TotalPicks mod PicksPerLine > 0 then     {+1 if partial row of picks}
  147.      Fulldepth := Fulldepth + 1;
  148.     If Fulldepth > 23 then Heading := '';       {check there is room for head}
  149.     If length(Heading) > 0 then
  150.      Fulldepth := fulldepth + 2;                { add 1 for blank line }
  151.     If Fulldepth > 25 then
  152.     begin
  153.      TotalPicks := 25 * PicksPerLine;
  154.      Fulldepth := 25;
  155.     end;
  156.     If Fulldepth > 23 then BoxType := 0;
  157.     If BoxType <> 0 then Fulldepth := Fulldepth + 2;
  158.     If TopLeftXY[2] <= 0 then
  159.      TopLeftXY[2] := (25 - Fulldepth) div 2 +1;
  160.     If TopLeftXY[2] + Fulldepth - 1 <= 25 then
  161.      Y2 := TopleftXY[2] + Fulldepth - 1
  162.     else
  163.     begin
  164.      Y2 := 25;
  165.      TopLeftXY[2] := 25 - Fulldepth + 1;
  166.     end;
  167.    end;   {do}
  168.    end;   {proc GetDimensions}
  169.  
  170.    Procedure Write_Text(Item:integer;Highlight:boolean);
  171.    Var X,Y,A:integer;
  172.    begin
  173.    With MenuDEf do
  174.    begin
  175.     A := Item mod PicksPerLine;
  176.     Y := Item div PicksPerLine +TopleftXY[2] - 1;
  177.     If A  <> 0 then
  178.      Y := Y + 1;
  179.     If BoxType > 0 then Y := Y + 1;               {add 1 for top box line    }
  180.     If length(Heading) > 0 then Y := Y + 2 ;      {add 2 for space and header}
  181.     If A = 0 then A := PicksPerLine;      {A is now the no of picks from left}
  182.     X := (A - 1)*(TextWidth + 1)+ TopleftXY[1]+1;{title width + 1 for a space}
  183.     If Boxtype > 0 then X := X + 1;              {add 1 for the left box line}
  184.     If Highlight then
  185.      WriteAt(X,Y,colors[1],colors[2],text[item])
  186.     else
  187.      WriteAT(X,Y,colors[3],colors[4],text[item]);
  188.    end;  {do}
  189.    end;  {Proc Write_Text}
  190.  
  191.    Procedure CreateMenu;
  192.    begin
  193.    with MenuDef do
  194.    begin
  195.     If Window then
  196.      MkWin(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[3],colors[4],0)
  197.     else
  198.      ClearText(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[3],colors[4]);
  199.     If (Boxtype > 0) and (Boxtype <= 4) then
  200.      Box(TopLeftXY[1],TopLeftXY[2],X2,Y2,colors[5],colors[4],Boxtype);
  201.     If length(Heading) > 0 then
  202.      WriteBetween
  203.      (TopleftXY[1],X2,TopLeftXY[2]+1,colors[5],colors[4],Heading);
  204.     For I := 1 to TotalPicks do
  205.      Write_Text(I,false);
  206.     Write_Text(Choice,True);       {Highlight Default}
  207.    end; {do}
  208.    end; {Proc CreateMenu}
  209.  
  210.    Procedure Process_Keystrokes;
  211.    var Selected: Boolean;CHpk:char;Oldchoice:integer;
  212.    begin
  213.    Selected := false;
  214.    With MenuDef do
  215.    begin
  216.     Repeat
  217.      Wait_for_Keypress(CHpk);
  218.      If CHpk  in [' ',Esckey,EnterKey] then funckey := true;
  219.      If Funckey = true then
  220.      begin
  221.       Case Upcase(CHpk) of
  222.       CursorDown         : begin
  223.                             Write_text(Choice,false);
  224.                             Choice := Choice + PicksPerLine;
  225.                             If Choice > TotalPicks then
  226.                              Choice := (Choice mod PicksPerLine) + 1;
  227.                             Write_Text(Choice,true);
  228.                            end;
  229.       CursorUp           : begin
  230.                             Write_Text(Choice,false);
  231.                             Choice := Choice - PicksPerLine;
  232.                             If Choice < 1 then
  233.                             begin
  234.                              Choice := Choice + PicksPerline;
  235.                              Choice :=
  236.                              ((TotalPicks div PicksPerLine)*PicksPerLine)
  237.                              - PicksPerLine + 1 + Choice - 2;
  238.                              If Choice + PicksPerLine <= TotalPicks then
  239.                               Choice := Choice + PicksPerLine;   {phew!}
  240.                             end;
  241.                             Write_Text(Choice,true);
  242.                            end;
  243.       CursorLeft         : begin
  244.                             Write_Text(Choice,False);
  245.                             Choice := choice - 1;
  246.                             If choice = 0 then Choice := PicksPerLine;
  247.                             Write_Text(Choice,true);
  248.                            end;
  249.       ' ',
  250.       CursorRight        : begin
  251.                             Write_Text(Choice,false);
  252.                             Choice := Choice + 1;
  253.                             If choice > TotalPicks then Choice := 1;
  254.                             Write_Text(Choice,true);
  255.                            end;
  256.       HomeKey            : begin
  257.                             Write_Text(Choice,false);
  258.                             Choice := 1;
  259.                             Write_Text(Choice,true);
  260.                            end;
  261.       Endkey             : begin
  262.                             Write_Text(Choice,false);
  263.                             Choice := TotalPicks;
  264.                             Write_Text(Choice,true);
  265.                            end;
  266.       EnterKey           : begin
  267.                             Selected := true;
  268.                             Errorcode := 0;
  269.                            end;
  270.       EscKey             : If AllowEsc then
  271.                            begin
  272.                             Selected := true;
  273.                             ErrorCode := 99;
  274.                            end;
  275.       F1,F2,F3,F4,F5,
  276.       F6,F7,F8,F9,F10    : If Addprefix = 3 then
  277.                            begin
  278.                             Oldchoice := Choice;
  279.                             Case Upcase(Chpk) of
  280.                             F1 : If TotalPicks >= 1  then choice := 1 else choice := 0;
  281.                             F2 : If TotalPicks >= 2  then choice := 2 else choice := 0;
  282.                             F3 : If TotalPicks >= 3  then choice := 3 else choice := 0;
  283.                             F4 : If TotalPicks >= 4  then choice := 4 else choice := 0;
  284.                             F5 : If TotalPicks >= 5  then choice := 5 else choice := 0;
  285.                             F6 : If TotalPicks >= 6  then choice := 6 else choice := 0;
  286.                             F7 : If TotalPicks >= 7  then choice := 7 else choice := 0;
  287.                             F8 : If TotalPicks >= 8  then choice := 8 else choice := 0;
  288.                             F9 : If TotalPicks >= 9  then choice := 9 else choice := 0;
  289.                             F10: If TotalPicks >= 10 then choice := 10 else choice := 0;
  290.                             end;  {case}
  291.                             If Choice = 0 then
  292.                              Choice := Oldchoice
  293.                             else
  294.                             begin
  295.                              Write_Text(Oldchoice,false);
  296.                              Write_Text(Choice,true);
  297.                              Selected := true;
  298.                              Errorcode := 0;
  299.                             end;
  300.                            end;
  301.       end; {case}
  302.      end   {Funckey true}
  303.      else  {funkey false}
  304.      begin
  305.       If (AddPrefix in [1,3]) then   {Number or Function Prefix}
  306.       begin
  307.        If (Str_to_int(CHpk) in [1..TotalPicks]) then
  308.        begin
  309.         Write_Text(Choice,false);
  310.         Choice := Str_to_Int(CHpk);
  311.         Write_Text(Choice,true);
  312.         Selected := true;
  313.         ErrorCode := 0;
  314.        end;
  315.       end
  316.       else                     {Letter Prefix}
  317.        If AddPrefix = 2 then
  318.         If (pos(upcase(CHpk),Alphabet) in [1..TotalPicks]) then
  319.         begin
  320.          Write_Text(Choice,false);
  321.          Choice := pos(upcase(CHpk),Alphabet);
  322.          Write_Text(Choice,true);
  323.          Selected := true;
  324.          Errorcode := 0;
  325.         end;
  326.      end;
  327.     Until Selected;
  328.    end; {do}
  329.    end; {proc Process_keystrokes}
  330.  
  331. begin
  332. GetDimensions;
  333. CreateMenu;
  334. Process_Keystrokes;
  335. If Window then RmWin;
  336. end;        {Main Procedure DisplayMenu}
  337.  
  338.